(define-module (bench-context-free)
  #:use-module (srfi srfi-26)
  #:use-module (srfi srfi-64)
  #:use-module (ice-9 match)
  #:use-module (statprof)
  #:use-module (derivative parse context-free))

(define-syntax with-timing
  (syntax-rules ()
    ((_ #:loop n body ...)
     (begin
       (statprof-reset 0 5000 #t)
       (statprof-start)
       (let loop ((i n))
         (when (> i 0)
           body ...
           (loop (1- i))))
       (statprof-stop)
       (format #t "time: ~a~%" (/ (statprof-accumulated-time)
                                  n))))
    ((_ body ...)
     (begin
       (statprof-reset 0 5000 #t)
       (statprof-start)
       body ...
       (statprof-stop)
       (format #t "time: ~a~%" (statprof-accumulated-time))))))

(test-begin "bench-context-free")

(with-output-to-file "bench-context-free.txt"
  (lambda ()
    (with-timing
     (test-assert "parse: trim"
       (match (parse/debug (pk 'input "        hello, world")
                           (trim-left (string "hello, world")))
         (() #f)
         (else #t))))

    (with-timing
     (test-assert "parse: trim lower-case"
       (match (parse/debug (pk 'input "        abcdefghijkl")
                           (trim-left lower-case+))
         (() #f)
         (else #t))))

    (with-timing
     (test-assert "parse: trim both"
       (match (parse/debug (pk 'input "       abcdefgh     ")
                           (trim lower-case+))
         (() #f)
         (else #t))))

    (with-timing
     (test-assert "parse: parens full"
       (match (parse/debug (pk 'input "(((((((((())))))))))")
                           parens-lang)
         (() #f)
         (else #t))))
    
    (with-timing
     (test-assert "parse: parens split"
       (match (parse/debug (pk 'input "((((()))))((((()))))")
                           parens-lang)
         (() #f)
         (else #t))))
    
    (with-timing
     (test-assert "parse: parens independent"
       (match (parse/debug (pk 'input "()()()()()()()()()()")
                           parens-lang)
         (() #f)
         (else #t))))

    (with-timing
     (test-assert "parse: scheme"
       (match (parse/debug (pk 'input "(define foo (bar frob))")
                           scheme-parser)
         (() #f)
         (else #t))))

    (with-timing
     (test-assert "parse: pcre"
       (match (pcre->parser (pk 'input "foo[abc]{4,}"))
         (() #f)
         (else #t))))

    (with-timing
     (test-assert "parse: pcre 2"
       (match (pcre->parser (pk 'input "[a-z][A-Z][a-z]{5}bar"))
         (() #f)
         (else #t))))))

(test-end "bench-context-free")
